home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d1 / dosclr.arc / DOSCOLOR.BAS (.txt) next >
Encoding:
GW-BASIC  |  1988-11-30  |  4.8 KB  |  186 lines
  1. 10  REM
  2. 20  REM  AUTHOR - JIM BRACKING
  3. 30  REM  DATE   - 11/27/83
  4. 40  REM  DISCRIPTION  -  SELECT A FOREGROUND,BACKGROUNG AND BORDER COLOR
  5. 50  REM                  AND CREATE A DEBUG SCRIPT FOR MODIFING THE "CLS"
  6. 60  REM                  COMMAND IN COMMAND.COM TO USE THESE COLORS.
  7. 70  REM
  8. 80  FOR I=0 TO 3:SCREEN 0,,I,I:CLS:NEXT I
  9. 90  KEY OFF:FOR I=1 TO 10
  10. 100  KEY I,""
  11. 110  NEXT I
  12. 120  SCREEN 0,,2,2:COLOR 7,0,0:CLS:KEY OFF
  13. 130  COLOR 7,0,0
  14. 140  CLS
  15. 150  DIM CTBL$(16)
  16. 160  CTBL$(0)="BLACK "
  17. 170  CTBL$(1)="BLUE  "
  18. 180  CTBL$(2)="GREEN "
  19. 190  CTBL$(3)="CYAN  "
  20. 200  CTBL$(4)="RED   "
  21. 210  CTBL$(5)="PURPLE"
  22. 220  CTBL$(6)="BROWN "
  23. 230  CTBL$(7)="WHITE "
  24. 240  CTBL$(8)="GRAY  "
  25. 250  CTBL$(9)="LT BLU"
  26. 260  CTBL$(10)="LT GRN"
  27. 270  CTBL$(11)="L CYAN"
  28. 280  CTBL$(12)="LT RED"
  29. 290  CTBL$(13)="VIOLET"
  30. 300  CTBL$(14)="YELLOW"
  31. 310  CTBL$(15)="HI WTE"
  32. 320   TITLE$="C O L O R    S E L E C T I O N"
  33. 330  ROW=1:GOSUB 1630
  34. 340  TITLE$="BACKGROUND COLOR"
  35. 350  ROW=3:GOSUB 1630
  36. 360  COL=12
  37. 370  FOR BG=0 TO 7
  38. 380  LOCATE 4,COL+1
  39. 390  IF BG=0 THEN COLOR 15 ELSE COLOR BG
  40. 400  PRINT CTBL$(BG);
  41. 410  COL=COL+8
  42. 420  NEXT BG
  43. 430  ROW=6:COL=1:TITLE$="FOREGROUND COLOR"
  44. 440  GOSUB 1750
  45. 450  FOR FG=0 TO 15
  46. 460  ROW=FG+6:COL=4
  47. 470  LOCATE ROW,COL
  48. 480  C=FG:IF C=0 THEN C=15
  49. 490  COLOR C,0
  50. 500  PRINT CTBL$(FG);
  51. 510  COL=COL+8
  52. 520  FOR BG=0 TO 7
  53. 530  C=BG
  54. 540  LOCATE ROW,COL
  55. 550  COLOR FG,BG
  56. 560  PRINT CTBL$(FG);
  57. 570  COL=COL+8
  58. 580  NEXT BG
  59. 590  NEXT FG
  60. 600  COLOR ,,0
  61. 610  COLOR 7,0,0:LOCATE 23,27
  62. 620  PRINT "PRESS THE F1 KEY FOR HELP"
  63. 630  SCREEN 0,,1,2:COLOR 7,0,0:CLS:KEY OFF
  64. 640  LOCATE 2,10:PRINT "FROM THE MAIN SCREEN"
  65. 650  LOCATE 3,18:PRINT "      F1    -  HELP SCREEN"
  66. 660  LOCATE 4,18:PRINT "      F10   -  CREATE DEBUG UPDATE FILE USING THE"
  67. 670  LOCATE 5,18:PRINT "               CURRENT COLORS AND EXIT"
  68. 680  LOCATE 6,18:PRINT "      PGUP  -  INCREMENT THE BORDER COLOR"
  69. 690  LOCATE 7,18:PRINT "      PGDN  -  DECREMENT THE BORDER COLOR"
  70. 700  LOCATE 8,18:PRINT "      ENTER -  WILL DISPLAY A SAMPLE SCREEN WITH"
  71. 710  LOCATE 9,18:PRINT "               THE SELECTED COLORS"
  72. 720  LOCATE 11,10:PRINT "FROM THE TEXT SCREEN"
  73. 730  LOCATE 12,18:PRINT "      ESC   -  RETURN TO MAIN SCREEN"
  74. 740  LOCATE 13,18:PRINT "      PGDN  -  INCREMENT THE BORDER COLOR"
  75. 750  LOCATE 14,18:PRINT "      PGDN  -  DECREMENT THE BORDER COLOR"
  76. 760  LOCATE 16,10:PRINT "FROM THE HELP SCREEN"
  77. 770  LOCATE 17,18:PRINT "      ESC   -  RETURN TO MAIN SCREEN"
  78. 780  SCREEN 0,,2,2
  79. 790  RPOS=0:CPOS=0:LOCATE RPOS+6,(CPOS*8)+11,1:BD=0
  80. 800  LOCATE ,,1,6,8
  81. 810  GOTO 1070
  82. 820  XKEY$=INKEY$:IF XKEY$="" THEN GOTO 820
  83. 830  IF ASC(XKEY$)=13 THEN GOTO 1170
  84. 840  IF LEN(XKEY$)<>2 THEN GOTO 930  'BAD KEY
  85. 850  IF ASC(MID$(XKEY$,2,1))=59 THEN GOTO 940
  86. 860  IF ASC(MID$(XKEY$,2,1))=68 THEN GOTO 1500
  87. 870   IF ASC(MID$(XKEY$,2,1))=73 THEN GOTO 1030
  88. 880   IF ASC(MID$(XKEY$,2,1))=81 THEN GOTO 1050
  89. 890  IF ASC(MID$(XKEY$,2,1))=72 THEN GOTO 980
  90. 900  IF ASC(MID$(XKEY$,2,1))=80 THEN GOTO 990
  91. 910  IF ASC(MID$(XKEY$,2,1))=75 THEN GOTO 1000
  92. 920  IF ASC(MID$(XKEY$,2,1))=77 THEN GOTO 1010
  93. 930  SOUND 100,6:GOTO 820
  94. 940  LOCATE ,,0:SCREEN 0,,1,1
  95. 950  XKEY$=INKEY$:IF XKEY$="" THEN GOTO 950
  96. 960  IF ASC(XKEY$)<>27 THEN GOTO 950
  97. 970  SCREEN 0,,2,2:GOTO 1070
  98. 980  IF RPOS=0 THEN GOTO 930 ELSE RPOS=RPOS-1:GOTO 1070
  99. 990  IF RPOS=15   THEN GOTO 930 ELSE RPOS=RPOS+1:GOTO 1070
  100. 1000  IF CPOS=0 THEN GOTO 930 ELSE CPOS=CPOS-1:GOTO 1070
  101. 1010  IF CPOS=7 THEN GOTO 930 ELSE CPOS=CPOS+1:GOTO 1070
  102. 1020  LOCATE RPOS+6,(CPOS*8)+11,1:GOTO 820
  103. 1030  BD=BD+1:IF BD>15 THEN BD=0
  104. 1040  COLOR ,,BD:GOTO 1070
  105. 1050  BD=BD-1:IF BD<0 THEN BD=15
  106. 1060  COLOR ,,BD
  107. 1070  CBD=BD:CFG=RPOS:CBG=CPOS
  108. 1080  LOCATE 25,33:COLOR 15,0
  109. 1090  PRINT "COLOR ";
  110. 1100  IF CFG<10 THEN PRINT USING "#";CFG; ELSE PRINT USING "##";CFG;
  111. 1110  PRINT ",";
  112. 1120  IF CBG<10 THEN PRINT USING "#";CBG; ELSE PRINT USING "##";CBG;
  113. 1130  PRINT ",";
  114. 1140  IF CBD<10 THEN PRINT USING "#";CBD; ELSE PRINT USING "##";CBD;
  115. 1150  PRINT "  ";
  116. 1160  GOTO 1020
  117. 1170  SCREEN 0,,3,3
  118. 1180  COLOR CFG,CBG,CBD:CLS
  119. 1190  LOCATE 1,1
  120. 1200  PRINT "                   ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  121. 1210  PRINT "                   abcdefghijklmnopqrstuvwxyz"
  122. 1220  PRINT "                   0123456789!@#$%^&*()_+}{:~"
  123. 1230  PRINT "                          \,./;'`[]-="
  124. 1240  PRINT "       NOW YOU CAN ENTER SOMETHING. PRESS THE ESCAPE KEY TO RETURN"
  125. 1250  LOCATE 25,33
  126. 1260  PRINT "COLOR ";
  127. 1270  IF CFG<10 THEN PRINT USING "#";CFG; ELSE PRINT USING "##";CFG;
  128. 1280  PRINT ",";
  129. 1290  IF CBG<10 THEN PRINT USING "#";CBG; ELSE PRINT USING "##";CBG;
  130. 1300  PRINT ",";
  131. 1310  IF CBD<10 THEN PRINT USING "#";CBD; ELSE PRINT USING "##";CBD;
  132. 1320  PRINT "  ";
  133. 1330  XXROW=7:XXCOL=1:LOCATE XXROW,XXCOL,1,6,7
  134. 1340  XKEY$=INKEY$:IF XKEY$="" THEN GOTO 1340
  135. 1350  IF LEN(XKEY$)<>2 THEN GOTO 1380
  136. 1360  IF ASC(MID$(XKEY$,2,1))=73 THEN GOTO 1460
  137. 1370  IF ASC(MID$(XKEY$,2,1))=81 THEN GOTO 1480
  138. 1380  IF ASC(XKEY$)=13 THEN XXCOL=1:GOTO 1430
  139. 1390  IF ASC(XKEY$)=27 THEN SCREEN 0,,2,2:LOCATE ,,1,6,8:GOTO 1020
  140. 1400  PRINT XKEY$;
  141. 1410  XXCOL=XXCOL+1
  142. 1420  IF XXCOL>80 THEN XXCOL=1 ELSE GOTO 1340
  143. 1430  XXROW=XXROW+1
  144. 1440  IF XXROW<24 THEN LOCATE XXROW,XXCOL,1:GOTO 1340
  145. 1450  PRINT " ":XXROW=24:XXCOL=1:GOTO 1340
  146. 1460  BD=BD+1:IF BD>15 THEN BD=0
  147. 1470  CBD=BD:COLOR ,,CBD:GOTO 1250
  148. 1480  BD=BD-1:IF BD<0 THEN BD=15
  149. 1490  CBD=BD:COLOR ,,CBD:GOTO 1250
  150. 1500  OPEN "DEBUG.TXT" FOR OUTPUT AS #1
  151. 1510  PRINT #1,"A 2331"
  152. 1520  PRINT #1,"MOV AL,";HEX$(CBD)
  153. 1530  PRINT #1,"MOV DX,03D9"
  154. 1540  PRINT #1,"OUT DX,AL"
  155. 1550  PRINT #1,""
  156. 1560  PRINT #1,"A 2345"
  157. 1570  PRINT #1,"MOV BH,";HEX$((CBG*16)+CFG)
  158. 1580  PRINT #1,""
  159. 1590  PRINT #1,"W"
  160. 1600  PRINT #1,"Q"
  161. 1610  CLOSE #1
  162. 1620  SCREEN 0,,0,0:COLOR 7,0,0:CLS:LOCATE ,,1,6,7:SYSTEM
  163. 1630  L=LEN(TITLE$)
  164. 1640  COL=(80-L)/2:C=1
  165. 1650  FOR II=1 TO L
  166. 1660  LOCATE ROW,COL
  167. 1670  IF MID$(TITLE$,II,1)=" " THEN GOTO 1720
  168. 1680  COLOR C
  169. 1690  PRINT MID$(TITLE$,II,1);
  170. 1700  C=C+1:IF C=16 THEN C=1
  171. 1710  IF C=8 THEN C=9
  172. 1720  COL=COL+1
  173. 1730  NEXT II
  174. 1740  RETURN
  175. 1750  L=LEN(TITLE$)
  176. 1760  FOR II=1 TO L
  177. 1770  LOCATE ROW,COL
  178. 1780  IF MID$(TITLE$,II,1)=" " THEN GOTO 1830
  179. 1790  COLOR C
  180. 1800  PRINT MID$(TITLE$,II,1);
  181. 1810  C=C+1:IF C=16 THEN C=1
  182. 1820  IF C=8 THEN C=9
  183. 1830  ROW=ROW+1
  184. 1840  NEXT II
  185. 1850  RETURN
  186.